home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 027a / foxcolor.zip / UTCOLOR.PRG < prev   
Text File  |  1990-10-23  |  22KB  |  767 lines
  1. * Program.: UTCOLOR.PRG
  2. * Author..: Fran Williamson
  3. * Date....: 09/24/90
  4. * Notice..: Copyright (c) 1990, Jeffco Public Schools
  5. * Version.: FoxPro, revision 2.10
  6. * Notes...: Show the user some color choices from UTCOLOR.DBF,
  7. *           If the user wants to make a new combination, s/he may do so
  8. *           using the color picker procedures in this program
  9.        
  10. PRIVATE ICOLREC, ROWLINE, COLBUNCH, COLCHOICE, COLORSEOF,;
  11.     NTEXT, NSAYS, NGETS, NMENF, NMENB, NHIGF, NHIGB, NBACK, NMSSG,;
  12.     RECHOOSE, SBUNCH, SCRCHOICE, CBUNCH, COLORPAL, CDELETED, COLMAX,;
  13.     MENV_TALK, MENV_STAT, MENV_BLIN, MENV_SCBD, MENV_CURS, MENV_DELT, MENV_ESCA,;
  14.     ARRIGHT, ARRLEFT, ARRDOWN, ARRUP, READNEW, NEWCOLOR
  15. **    SAVE CURRENT ENVIRONMENT
  16. MENV_TALK = SET('TALK')
  17. MENV_STAT = SET('STATUS')
  18. MENV_BLIN = SET('BLINK')
  19. MENV_SCBD = SET('SCOREBOARD')
  20. MENV_CURS = SET('CURSOR')
  21. MENV_DELT = SET('DELETED')
  22. MENV_ESCA = SET('ESCAPE')
  23. **    CHANGE ENVIRONMENT
  24. SET TALK OFF
  25. SET STATUS OFF
  26. SET BLINK OFF
  27. SET SCOREBOARD OFF
  28. SET CURSOR OFF
  29. SET DELETED ON
  30. SET ESCAPE ON
  31. **    MAKE ARROWS FOR SCREEN OUTPUT
  32. ARRUP = ' '+CHR(24)+' '
  33. ARRDOWN = ' '+CHR(25)+' '
  34. ARRIGHT = ' '+CHR(26)+' '
  35. ARRLEFT = ' '+CHR(27)+' '
  36. **    SET UP MAX OF 15 COLORS RECORDS ARRAY
  37. STORE 15 TO COLMAX
  38. DIMENSION COLORREC(15)
  39. DIMENSION CHOICES(15)
  40. DIMENSION RECNUM(15)
  41. **     SET UP THE 8 SCREEN AREAS TO ALLOW USER TO CHANGE
  42. DIMENSION SCRAREAS(8)
  43. STORE 'BACKGROUND' TO SCRAREAS(1)
  44. STORE 'MENU FOREGROUND' TO SCRAREAS(2)
  45. STORE 'MENU BACKGROUND' TO SCRAREAS(3)
  46. STORE 'HIGHLIGHT FOREGROUND' TO SCRAREAS(4)
  47. STORE 'HIGHLIGHT BACKGROUND' TO SCRAREAS(5)
  48. STORE 'TEXT FOREGROUND' TO SCRAREAS(6)
  49. STORE 'DATA FOREGROUND' TO SCRAREAS(7)
  50. STORE 'INPUT BACKGROUND' TO SCRAREAS(8)
  51. STORE 8 TO SBUNCH
  52. **    SAVE ROW AND COLUMNS FOR ARROW POSITIONS OF THE SCREEN AREAS
  53. DIMENSION SROWARR(12)
  54. DIMENSION SCOLARR(12)
  55. STORE 6 TO SROWARR(1)
  56. STORE 2 TO SROWARR(2)
  57. STORE 2 TO SROWARR(3)
  58. STORE 3 TO SROWARR(4)
  59. STORE 3 TO SROWARR(5)
  60. STORE 10 TO SROWARR(6)
  61. STORE 13 TO SROWARR(7)
  62. STORE 14 TO SROWARR(8)
  63. **  9, 10 ARE EXTRA ARROW POSITIONS FOR THE SCREEN TEXT AREA
  64. STORE 13 TO SROWARR(9)
  65. STORE 14 TO SROWARR(10)
  66. ** 11, 12 ARE EXTRA ARROW POSITIONS FOR THE MENU FOREGROUND AND BACKGROUND
  67. STORE 4 TO SROWARR(11)
  68. STORE 5 TO SROWARR(12)
  69. STORE 25 TO SCOLARR(1)
  70. STORE 17 TO SCOLARR(2)
  71. STORE 17 TO SCOLARR(3)
  72. STORE 17 TO SCOLARR(4)
  73. STORE 17 TO SCOLARR(5)
  74. STORE 43 TO SCOLARR(6)
  75. STORE 44 TO SCOLARR(7)
  76. STORE 40 TO SCOLARR(8)
  77. **  9, 10 ARE EXTRA ARROW POSITIONS FOR THE SCREEN TEXT AREA
  78. STORE 9 TO SCOLARR(9)
  79. STORE 9 TO SCOLARR(10)
  80. ** 11, 12 ARE EXTRA ARROW POSITIONS FOR THE MENU FOREGROUND AND BACKGROUND
  81. STORE 17 TO SCOLARR(11)
  82. STORE 17 TO SCOLARR(12)
  83. **    SET UP THE 16 POSSIBLE COLORS FOR USER TO SELECT
  84. DIMENSION COLORS(16)
  85. store 'W+' to colors(1)
  86. STORE 'W' TO COLORS(2)
  87. STORE 'N+' TO COLORS(3)
  88. STORE 'N' TO COLORS(4)
  89. STORE 'GR' TO COLORS(5)
  90. STORE 'R' TO COLORS(6)
  91. STORE 'R+' TO COLORS(7)
  92. STORE 'RB' TO COLORS(8)
  93. STORE 'RB+' TO COLORS(9)
  94. STORE 'B' TO COLORS(10)
  95. STORE 'B+' TO COLORS(11)
  96. STORE 'BG' TO COLORS(12)
  97. STORE 'BG+' TO COLORS(13)
  98. STORE 'G' TO COLORS(14)
  99. STORE 'G+' TO COLORS(15)
  100. STORE 'GR+' TO COLORS(16)
  101. STORE 16 TO CBUNCH
  102. STORE .F. TO NTEXT, NSAYS, NGETS, NMENF, NMENB, NHIGF, NHIGB, NBACK, NMSSG
  103. **    BEGIN THE COLORS DISPLAY SCREEN
  104. ON ESCAPE DO ENDUTCOL
  105. SELECT (COLRAREA)
  106. USE UTCOLOR 
  107. **    CHECK FOR MONOCHROME SCREEN
  108. IF SUBSTR(SYS(2006),1,2) = 'MO'
  109.     REPLACE ALL PICKED WITH ' '
  110.     LOCATE FOR NAME = 'MONOCHROME'
  111.     REPLACE PICKED WITH 'X'
  112.     RETURN
  113. ENDIF
  114. **    FIND CURRENTLY PICKED COLOR COMBINATION
  115. LOCATE FOR PICKED == 'X'
  116. IF .NOT. FOUND()
  117.     GO TOP
  118. ENDIF
  119. STORE 1 TO ICOLREC
  120. STORE .F. TO COLORSEOF
  121. STORE .F. TO CDELETED
  122. STORE .F. TO NEWCOLOR
  123. STORE 0 TO COLBUNCH
  124. STORE 1 TO COLCHOICE
  125. SET COLOR OF NORMAL TO W/W
  126. CLEAR
  127. SET COLOR OF NORMAL TO W/N
  128. **    MAKE A PSUEDO WINDOW TO SHOW THE COLOR COMBINATIONS NAMES, 15 PER PAGE
  129. @ 0,55 CLEAR TO 16,80
  130. @ 0,55 TO 16,80 DOUBLE
  131. @ 0,63 SAY 'COLOR SETS'
  132. STORE .T. TO READNEW
  133. **    SHOW COLOR CHOICES BY NAME IN THE PSUEDO WINDOW
  134. DO COLPAGE
  135. STORE .T. TO RECHOOSE
  136. **    DO LOOP TO PROCESS THE USERS REQUEST OF CHANGING THE COLORS
  137. DO WHILE .T.
  138.     STORE INKEY() TO KEYPRESS
  139.     DO CASE
  140.         CASE KEYPRESS = 5       && UP ARROW
  141.             IF COLCHOICE > 1
  142.                 COLCHOICE = COLCHOICE - 1
  143.             ELSE
  144.                 COLCHOICE = 1
  145.                 IF .NOT. BOF()
  146.                     SKIP -1
  147.                     STORE .T. TO READNEW
  148.                 ENDIF
  149.             ENDIF
  150.             DO COLPAGE
  151.             STORE .T. TO RECHOOSE
  152.         CASE KEYPRESS = 24      && DOWN ARROW
  153.             IF COLCHOICE < COLBUNCH
  154.                 COLCHOICE = COLCHOICE + 1
  155.             ELSE
  156.                 COLCHOICE = COLBUNCH
  157.                 SKIP 1
  158.                 IF .NOT. EOF()
  159.                     GO RECORD RECNUM(2)  
  160.                     STORE .T. TO READNEW
  161.                 ELSE
  162.                     GO RECORD RECNUM(COLBUNCH)
  163.                 ENDIF
  164.             ENDIF
  165.             DO COLPAGE
  166.             STORE .T. TO RECHOOSE
  167.         CASE KEYPRESS = 3       && PAGE DOWN
  168.             GO RECORD RECNUM(COLBUNCH)
  169.                SKIP 1
  170.             IF .NOT. EOF()
  171.                 STORE .T. TO READNEW
  172.                 COLCHOICE = 1
  173.             ELSE
  174.                 GO RECORD RECNUM(COLBUNCH)
  175.                 COLCHOICE = COLBUNCH
  176.             ENDIF
  177.                DO COLPAGE
  178.             STORE .T. TO RECHOOSE
  179.         CASE KEYPRESS = 18      && PAGE UP
  180.             GO RECORD RECNUM(1)
  181.             SKIP -COLMAX
  182.             IF RECNO() <> RECNUM(1)
  183.                 STORE .T. TO READNEW
  184.             ENDIF
  185.             COLCHOICE = 1
  186.             DO COLPAGE
  187.             STORE .T. TO RECHOOSE
  188.         CASE KEYPRESS = 32          && ALT-D DELETE
  189.  **        DON'T ALLOW DELETION OF IBM OR MONOCHROME
  190.              IF NAME <> 'IBM' .AND. NAME <> 'MONOCHROME'
  191.                 DELETE
  192.                 STORE .T. TO READNEW
  193.                 STORE 0 TO RECNUM(COLCHOICE)
  194.                 STORE .T. TO CDELETED
  195.                 GO BOTTOM
  196. **                POSITION AT FIRST UNDELETED RECORD IN CURRENT SCREEN
  197.                 FOR I = 1 TO COLBUNCH
  198.                     IF RECNUM(I) > 0
  199.                         GO RECORD RECNUM(I)
  200.                         EXIT
  201.                     ENDIF
  202.                 ENDFOR
  203.             ELSE
  204.                 GO RECORD RECNUM(1)
  205.             ENDIF
  206.             DO COLPAGE
  207.             STORE .T. TO RECHOOSE
  208.         CASE KEYPRESS = 31          && ALT-S SELECT A COLOR COMBINATION
  209.             REPLACE ALL PICKED WITH ' '
  210.             GO RECORD RECNUM(COLCHOICE)
  211.             REPLACE PICKED WITH "X"
  212.             EXIT
  213.         CASE KEYPRESS = 30           && ALT-A ADD A COLOR COMBINATION
  214.             STORE .F. TO NEWCOLOR
  215.             DO COLORPIC
  216.             ON ESCAPE DO ENDUTCOL
  217.             SET COLOR OF NORMAL TO W/W
  218.             @ 17,0 CLEAR TO 24,80
  219.             SET COLOR OF NORMAL TO W/N
  220.             @ 0,55 CLEAR TO 16,80
  221.             @ 0,55 TO 16,80 DOUBLE
  222.             @ 0,63 SAY 'COLOR SETS'
  223.             IF NEWCOLOR
  224.                 REPLACE ALL PICKED WITH ' '
  225.                 GO BOTTOM
  226.                 REPLACE PICKED WITH "X"
  227.                 EXIT
  228.             ELSE
  229.                 DO COLPAGE
  230.                 STORE .T. TO RECHOOSE
  231.             ENDIF
  232.         CASE KEYPRESS = 27     && EXIT, NO SELECT
  233.             STORE .F. TO RECHOOSE
  234.             EXIT
  235.     ENDCASE
  236.     IF RECHOOSE 
  237.         SET COLOR OF NORMAL TO N/W
  238.         @ 23,0 CLEAR TO 24,80
  239.         @ 23,0 SAY '<'+ALLTRIM(ARRUP) + '><'+ALLTRIM(ARRDOWN)+'><PgUp><PgDn>=VIEW COLOR SETS'
  240.         @ 24,0 SAY '<ALT>{A}DD SET    <ALT>{D}ELETE SET    <ALT>{S}ELECT SET    <ESC>=EXIT'
  241.         GO RECORD RECNUM(COLCHOICE)
  242.         DO COL_CHOOSE
  243.         STORE .F. TO RECHOOSE
  244.     ENDIF
  245. ENDDO
  246. DO ENDUTCOL
  247. RETURN
  248.  
  249. ************************************************************
  250. *                         ENDUTCOL                         *
  251. ************************************************************
  252. **    LEAVING UTCOLOR, RESTORE ENVIRONMENT
  253. PROCEDURE ENDUTCOL
  254. DO SELCOLOR
  255. SET TALK &MENV_TALK
  256. SET STATUS &MENV_STAT
  257. SET BLINK &MENV_BLIN
  258. SET SCOREBOARD &MENV_SCBD
  259. SET CURSOR &MENV_CURS
  260. SET DELETED &MENV_DELT
  261. ON ESCAPE *
  262. SET ESCAPE &MENV_ESCA
  263. IF CDELETED
  264.     PACK
  265. ENDIF
  266. USE
  267. RETURN
  268.  
  269. ************************************************************
  270. *                         SELCOLOR                         *
  271. ************************************************************
  272. **    SAVE THE PICKED COLOR VALUES TO COLOR VARIABLES
  273. PROCEDURE SELCOLOR
  274. GO TOP
  275. LOCATE FOR PICKED == "X"
  276. IF .NOT. FOUND()
  277.     LOCATE FOR NAME = "IBM"
  278.     REPLACE PICKED WITH "X"
  279. ENDIF
  280. STORE TRIM(BACK) TO MBACK
  281. STORE TRIM(TEXT)+'/'+MBACK TO MTEXT
  282. STORE TRIM(SAYS)+'/'+MBACK TO MSAYS
  283. STORE TRIM(GETS) TO MGETS
  284. STORE MGETS TO MDELAST
  285. STORE TRIM(MENU) TO MMENU
  286. STORE TRIM(BOXS) TO MBOXS
  287. STORE TRIM(TITL) TO MTITL
  288. STORE TRIM(HIGH) TO MHIGH
  289. STORE TRIM(HOTK) TO MHOTK
  290. STORE TRIM(ERRMSG) TO MERRMSG
  291. STORE TRIM(WRNMSG) TO MWRNMSG
  292. **    CHANGE COLORS
  293. SET COLOR OF NORMAL TO &MTEXT
  294. SET COLOR OF MESSAGE TO &MMENU
  295. SET COLOR OF TITLES TO &MTITL
  296. SET COLOR OF BOX TO &MBOXS
  297. SET COLOR OF HIGHLIGHT TO &MHIGH
  298. SET COLOR OF INFORMATION TO &MHOTK
  299. SET COLOR OF FIELDS TO &MGETS
  300. CLEAR
  301. RETURN
  302.  
  303. ************************************************************
  304. *                         COLPAGE                          *
  305. ************************************************************
  306. **    SHOW THE NAMES OF EXISTING COLOR COMBINATIONS ON A PSUEDO WINDOW
  307. PROCEDURE COLPAGE
  308. IF READNEW
  309.     STORE 1 TO ICOLREC
  310.     STORE 0 TO COLBUNCH
  311.     STORE .F. TO COLORSEOF
  312.     FOR ICOLREC = 1 TO 15
  313.         IF .NOT. COLORSEOF
  314.             STORE UTCOLOR->NAME TO COLORREC(ICOLREC)
  315.             STORE RECNO() TO RECNUM(ICOLREC)
  316.             IF .NOT. EOF()
  317.                 SKIP 1
  318.                 COLBUNCH = COLBUNCH + 1
  319.             ENDIF
  320.         ELSE
  321.             STORE SPACE(10) TO COLORREC(ICOLREC)
  322.         ENDIF
  323.         IF EOF() 
  324.             STORE .T. TO COLORSEOF
  325.         ENDIF
  326.     ENDFOR
  327.     STORE .F. TO READNEW
  328.     IF NEWCOLOR
  329.         STORE COLBUNCH TO COLCHOICE
  330.     ENDIF
  331. ENDIF
  332. IF COLCHOICE > COLBUNCH
  333.     STORE COLBUNCH TO COLCHOICE
  334. ENDIF
  335. SET COLOR OF NORMAL TO W/N
  336. STORE 1 TO ROWLINE
  337. FOR I = 1 TO 15
  338.     IF COLCHOICE = I
  339.         @ ROWLINE,63 SAY COLORREC(I) COLOR N/W
  340.     ELSE
  341.         @ ROWLINE,63 SAY COLORREC(I)
  342.     ENDIF
  343.   ROWLINE = ROWLINE + 1
  344. ENDFOR
  345. RETURN
  346.  
  347.  
  348. ************************************************************
  349. *                         COL_CHOOSE                       *
  350. ************************************************************
  351. **    USE THE COLOR COMBINATIONS OF CURRENTLY HIGHLIGHTED RECORD
  352. **    SAVE THE COLOR VALUES FROM THE DATA BASE 
  353. **    DON'T USE ANY '*' ENHANCED COLOR ATTRIBUTES
  354. **    NONE OF THE BACKGROUND COLORS MAY BE HIGHLIGHT
  355. PROCEDURE COL_CHOOSE
  356. STORE NAME TO MNAME
  357. MBACK = TRIM(BACK)
  358. NBACK = MBACK
  359. NTEXT = TRIM(TEXT)
  360. STORE NTEXT+'/'+NBACK TO MTEXT
  361. NSAYS = TRIM(SAYS)
  362. STORE NSAYS+'/'+NBACK TO MSAYS
  363. **  USER MAY PICK THE BACKGROUND COLOR OF THE GETS
  364. **  THE FOREGROUND COLOR WILL BE THE SAME AS THE SAYS
  365. NGETS = SUBSTR(GETS,AT('/',GETS)+1)
  366. NGETS = TRIM(NGETS)
  367. STORE GETS TO MGETS
  368. **  NEED TO CHANGE MENU FOREGROUND TO HIGHLIGHT FOR THE COLOR PICKER DEMO;
  369. **  IF THE COLOR IS CHANGED AND SAVED TO THE COLORS DATABASE, THE COLOR
  370. **  WILL BE CHANGED TO NOT HIGHLIGHT ON THE DATABASE;
  371. **  BECAUSE FOXPRO AUTOMATICALLY CHANGES IT TO HIGHLIGHT IN USING IT
  372. **  SEPARATE THE FOREGROUND AND BACKGROUND COLOR OF THE MENUS.
  373. NMENF = SUBSTR(MENU,1,AT('/',MENU)-1)
  374. NMENB = SUBSTR(MENU,AT('/',MENU)+1)
  375. IF .NOT. ('+' $ NMENF)
  376.     NMENF = NMENF+'+'
  377. ENDIF
  378. MMENU = NMENF + '/' + NMENB
  379. NMSSG = SUBSTR(NMENF,1,AT('+',NMENF)-1)+'/'+NMENB
  380. STORE MMENU TO MBOXS
  381. STORE TRIM(TITL) TO MTITL
  382. **  SEPARATE THE FOREGROUND AND BACKGROUND COLOR OF THE HIGHLIGHTS
  383. NHIGF = SUBSTR(HIGH,1,AT('/',HIGH)-1)
  384. NHIGB = SUBSTR(HIGH,AT('/',HIGH)+1)
  385. STORE NHIGF + '/' + NHIGB TO MHIGH
  386. STORE HOTK TO MHOTK
  387. STORE TRIM(ERRMSG) TO MERRMSG
  388. STORE TRIM(WRNMSG) TO MWRNMSG
  389. DO SAMPLSCRN 
  390. RETURN
  391.  
  392.  
  393. ************************************************************
  394. *                         SAMPLSCRN                        *
  395. ************************************************************
  396. *  PAINT THE SAMPLE SCREEN FOR USER TO VIEW THE COLOR COMBINATION
  397. PROCEDURE SAMPLSCRN
  398. SET COLOR OF NORMAL TO &MTEXT
  399. @ 0,0 CLEAR TO 16,54
  400. SET COLOR OF NORMAL TO &MBOXS
  401. @ 0,0 CLEAR TO 0,54
  402. @ 0,0 CLEAR TO 6,15
  403. @ 1,0 TO 6,15 DOUBLE 
  404. SET COLOR OF NORMAL TO &MMENU
  405. @ 2,1 SAY 'FIRST CHOICE'
  406. @ 5,1 SAY 'THIRD CHOICE'
  407. @ 0,17 SAY 'MENU-ITEM 2     MENU-ITEM 3...'
  408. SET COLOR OF NORMAL TO &NMSSG
  409. @ 4,1 SAY '*SUB-HEADING*'
  410. SET COLOR OF NORMAL TO &MHIGH
  411. @ 0,0 SAY 'MENU-ITEM 1     '
  412. @ 2,1 SAY 'F'
  413. @ 3,1 SAY 'SECOND CHOICE'
  414. @ 5,1 SAY 'T'
  415. SET COLOR OF NORMAL TO &MTEXT
  416. @ 9,18 TO 11,41
  417. @ 10,23 SAY 'SAMPLE SCREEN'
  418. @ 13,13 SAY 'SCREEN TEXT:'
  419. @ 14,13 SAY 'SCREEN TEXT:'
  420. SET COLOR OF NORMAL TO &MSAYS
  421. @ 13,28 SAY 'PROTECTED DATA'
  422. SET COLOR OF NORMAL TO &MGETS
  423. STORE 'INPUT DATA' TO FIELDA
  424. @ 14,28 SAY FIELDA
  425. SET COLOR OF NORMAL TO &MTEXT
  426. RETURN
  427.  
  428.  
  429. ************************************************************
  430. *                         COLORPIC                         *
  431. ************************************************************
  432. *  LET USER PUT TOGETHER A NEW COLOR COMBINATION
  433. *  DISPLAYS OPTIONS TO BE CHANGED
  434. *  BACKGROUND, TEXT, SAY FIELDS, GET FIELDS, MENU, HIGHLIGHTS
  435. PROCEDURE COLORPIC
  436. PRIVATE KEYPRESS, ROWLINE, COLLINE, SAYLINE, NEWAREA,;
  437.         REPAINT, ARROW, ARRDIRECT
  438. STORE 0 TO ARRDIRECT
  439. ON ESCAPE RETURN
  440. STORE .F. TO KEYPRESS
  441. STORE .F. TO REPAINT
  442. SET COLOR OF NORMAL TO W/N
  443. @ 0,55 CLEAR TO 16,80
  444. @ 0,55 TO 16,80 DOUBLE
  445. @ 0,61 SAY 'SCREEN AREAS'
  446. STORE 1 TO SCRCHOICE
  447. STORE 1 TO COLORPAL
  448. DO COLPAINT
  449. SET COLOR OF NORMAL TO N/W
  450. @ 23,0 CLEAR TO 24,80
  451. @ 23,0 SAY '<'+ALLTRIM(ARRUP) + '><'+ALLTRIM(ARRDOWN)+'>=PICK SCREEN AREAS   <'+ALLTRIM(ARRLEFT)+'><'+ALLTRIM(ARRIGHT)+'>=PICK COLORS'
  452. @ 24,0 SAY '<ALT>{S}AVE SET     <ESC>=EXIT'
  453. SET COLOR OF NORMAL TO W/N
  454. STORE .T. TO NEWAREA
  455. STORE .T. TO REPAINT
  456. ** SHOW AREAS AND CURRENT COLORS, ALLOW USER TO CHANGE
  457. DO WHILE .T.
  458. **    POSITION ARROWS IN SAMPLE SCREEN OF CURRENTLY HIGHLIGHTED AREA
  459.     STORE SROWARR(SCRCHOICE) TO ROWLINE
  460.     STORE SCOLARR(SCRCHOICE) TO COLLINE
  461.     IF SCRCHOICE = 1  && BACKGROUND
  462.         STORE ARRLEFT+ARRIGHT TO SAYLINE
  463.     ELSE
  464.         STORE ARRLEFT TO SAYLINE
  465.     ENDIF
  466.     @ ROWLINE,COLLINE SAY SAYLINE COLOR W+/N
  467.     IF SCRCHOICE = 2 .OR. SCRCHOICE = 3
  468.         @ SROWARR(11),SCOLARR(11) SAY ARRLEFT COLOR W+/N
  469.         @ SROWARR(12),SCOLARR(12) SAY ARRLEFT COLOR W+/N
  470.     ELSE
  471.         SET COLOR OF NORMAL TO &MTEXT
  472.         @ SROWARR(11),SCOLARR(11) CLEAR TO SROWARR(11),SCOLARR(11)+3
  473.         @ SROWARR(12),SCOLARR(12) CLEAR TO SROWARR(12),SCOLARR(12)+3
  474.     ENDIF
  475.     IF SCRCHOICE = 6 && SCREEN TEXT
  476.         @ SROWARR(9),SCOLARR(9) SAY ARRIGHT COLOR W+/N
  477.         @ SROWARR(10),SCOLARR(10) SAY ARRIGHT COLOR W+/N
  478.     ELSE
  479.         SET COLOR OF NORMAL TO &MTEXT
  480.         @ SROWARR(9),SCOLARR(9) CLEAR TO SROWARR(9),SCOLARR(9)+3
  481.         @ SROWARR(10),SCOLARR(10) CLEAR TO SROWARR(10),SCOLARR(10)+3
  482.     ENDIF
  483.     IF SCRCHOICE = 7 .OR. SCRCHOICE = 8 && DATA FIELDS
  484.         @ SROWARR(8),SCOLARR(8) SAY ARRLEFT COLOR W+/N
  485.     ELSE
  486.         @ SROWARR(8),SCOLARR(8) CLEAR TO SROWARR(8),SCOLARR(8)+3
  487.     ENDIF
  488.     SET COLOR OF NORMAL TO W/N
  489.     STORE INKEY() TO KEYPRESS
  490.     DO CASE
  491. **-------------------------------------------------------------------
  492. **        UP AND DOWN ARROWS CHANGE SCREEN AREAS
  493. **-------------------------------------------------------------------
  494.         CASE KEYPRESS = 5      && UP ARROW, PICK NEW SCREEN AREA
  495.             @ 18,ARROW CLEAR TO 18,ARROW+3
  496.             SET COLOR OF NORMAL TO &MTEXT
  497.             @ ROWLINE,COLLINE CLEAR TO ROWLINE,COLLINE+5
  498.             SET COLOR OF NORMAL TO W/N
  499.             IF SCRCHOICE > 1
  500.                 SCRCHOICE = SCRCHOICE - 1
  501.             ELSE
  502.                 SCRCHOICE = SBUNCH
  503.             ENDIF
  504.             STORE .T. TO NEWAREA
  505.         CASE KEYPRESS = 24     && DOWN ARROW, PICK NEW SCREEN AREA
  506.             @ 18,ARROW CLEAR TO 18,ARROW+3
  507.             SET COLOR OF NORMAL TO &MTEXT
  508.             @ ROWLINE,COLLINE CLEAR TO ROWLINE,COLLINE+5 
  509.             SET COLOR OF NORMAL TO W/N
  510.             IF SCRCHOICE < SBUNCH
  511.                 SCRCHOICE = SCRCHOICE + 1
  512.             ELSE
  513.                 SCRCHOICE = 1
  514.             ENDIF
  515.             STORE .T. TO NEWAREA
  516. **-------------------------------------------------------------------
  517. **        RIGHT AND LEFT ARROWS CHANGE COLORS
  518. **-------------------------------------------------------------------
  519.         CASE KEYPRESS = 4        && RIGHT ARROW
  520.             @ 18,ARROW CLEAR TO 18,ARROW+3
  521.             STORE +1 TO ARRDIRECT
  522.             STORE .T. TO REPAINT
  523.         CASE KEYPRESS = 19       && LEFT ARROW
  524.             @ 18,ARROW CLEAR TO 18,ARROW+3
  525.             STORE -1 TO ARRDIRECT
  526.             STORE .T. TO REPAINT
  527. **-------------------------------------------------------------------
  528. **        ALT-S WILL SAVE THE COLOR COMBINATION TO THE FILE, NEW NAME
  529. **-------------------------------------------------------------------
  530.         CASE KEYPRESS = 31        && ALT-S
  531.             STORE .T. TO NEWCOLOR
  532.             DO COLSAVE
  533.             EXIT
  534.         CASE KEYPRESS = 27 .OR. KEYPRESS = 19     && EXIT, NO SELECT
  535.             EXIT
  536.     ENDCASE
  537.     IF NEWAREA
  538.         DO SCRPAGE
  539.         DO PICKAREA
  540.         STORE .F. TO NEWAREA
  541.     ENDIF
  542.     IF REPAINT
  543.         DO PICKPAINT
  544.         STORE .F. TO REPAINT
  545.     ENDIF
  546.     SET COLOR OF NORMAL TO W/N
  547.     ARROW = ((COLORPAL-1)*4)+9
  548.     @ 18,ARROW SAY ARRDOWN COLOR W+/N
  549. ENDDO
  550. RETURN
  551.  
  552.  
  553. ************************************************************
  554. *                         SCRPAGE                          *
  555. ************************************************************
  556. **    SHOW ALL SCREEN AREA CHOICES, HIGHLIGHT CURRENT CHOICE
  557. PROCEDURE SCRPAGE
  558. PRIVATE ROWLINE, I
  559. SET COLOR OF NORMAL TO W/N
  560. SET COLOR OF FIELDS TO W/N
  561. STORE 2 TO ROWLINE
  562. FOR I = 1 TO SBUNCH
  563.     IF I = SCRCHOICE
  564.         @ ROWLINE,57 SAY SCRAREAS(I) COLOR N/W
  565.     ELSE
  566.         @ ROWLINE,57 SAY SCRAREAS(I) COLOR W/N
  567.     ENDIF
  568.   ROWLINE = ROWLINE + 1
  569. ENDFOR
  570. RETURN
  571.  
  572. ************************************************************
  573. *                         COLPAINT                         *
  574. ************************************************************
  575. **    SHOWS THE COLOR PALETTE IN A PSUEDO WINDOW
  576. PROCEDURE COLPAINT
  577. PRIVATE COLLINE, CBLOCK
  578. CBLOCK = REPLICATE(CHR(219),4)
  579. STORE 9 TO COLLINE
  580. SET COLOR OF NORMAL TO W/N
  581. @ 17,0 CLEAR TO 21,80
  582. @ 17,0 TO 21,80 DOUBLE
  583. FOR I = 1 TO 16
  584.     @ 20,COLLINE say CBLOCK COLOR &COLORS(I)
  585.     COLLINE = COLLINE + 4
  586. ENDFOR
  587. RETURN
  588.  
  589.  
  590. ************************************************************
  591. *                         PICKAREA                         *
  592. ************************************************************
  593. PROCEDURE PICKAREA
  594. **    THE ARROW WILL POSITION AT THE CURRENT COLOR OF THE CURRENT AREA
  595. **    LETS USER PICK COLOR FROM PALETTE (COLPAINT)
  596. PRIVATE  SCAREA, NOWCOLOR
  597. DO CASE
  598.     CASE SCRCHOICE = 1
  599.         STORE NBACK TO NOWCOLOR
  600.     CASE SCRCHOICE = 2
  601.         STORE NMENF TO NOWCOLOR
  602.     CASE SCRCHOICE = 3
  603.         STORE NMENB TO NOWCOLOR
  604.     CASE SCRCHOICE = 4
  605.         STORE NHIGF TO NOWCOLOR
  606.     CASE SCRCHOICE = 5
  607.         STORE NHIGB TO NOWCOLOR
  608.     CASE SCRCHOICE = 6
  609.         STORE NTEXT TO NOWCOLOR
  610.     CASE SCRCHOICE = 7
  611.         STORE NSAYS TO NOWCOLOR
  612.     CASE SCRCHOICE = 8
  613.         STORE NGETS TO NOWCOLOR
  614. ENDCASE
  615. NOWCOLOR = TRIM(NOWCOLOR)
  616. STORE 1 TO COLORPAL
  617. FOR I = 1 TO 16
  618.     IF NOWCOLOR == COLORS(I)
  619.         STORE I TO COLORPAL
  620.         EXIT
  621.     ENDIF
  622. ENDFOR
  623. RETURN
  624.  
  625. ************************************************************
  626. *                         PICKPAINT                        *
  627. ************************************************************
  628. **    MOVE CHOSEN COLOR TO APPROPRIATE AREA COLOR
  629. PROCEDURE PICKPAINT
  630. PRIVATE NEWCOLOR
  631. COLORPAL = COLORPAL + ARRDIRECT
  632. IF COLORPAL < 1
  633.     COLORPAL = CBUNCH
  634. ENDIF
  635. IF COLORPAL > CBUNCH
  636.     COLORPAL = 1
  637. ENDIF
  638. **    MENU BACKGROUND AND HIGHLIGHT BACKGROUND COLORS
  639. **    ARE NOT ALLOWED TO BE BRIGHT
  640. IF (SCRCHOICE = 3 .OR. SCRCHOICE = 5)
  641.     DO WHILE ('+' $ COLORS(COLORPAL))
  642.         COLORPAL = COLORPAL + ARRDIRECT
  643.         IF COLORPAL < 1
  644.             COLORPAL = CBUNCH
  645.         ENDIF
  646.         IF COLORPAL > CBUNCH
  647.             COLORPAL = 1
  648.         ENDIF
  649.     ENDDO
  650. ENDIF
  651. **    MAIN SCREEN BACKGROUND AND INPUT BACKGROUND COLORS
  652. **    ARE NOT ALLOWED TO BE BRIGHT, AND NOT ALLOWED TO BE EQUAL
  653. IF (SCRCHOICE = 1)
  654.     DO WHILE ('+' $ COLORS(COLORPAL) .OR. COLORS(COLORPAL) == NGETS)
  655.         COLORPAL = COLORPAL + ARRDIRECT
  656.         IF COLORPAL < 1
  657.             COLORPAL = CBUNCH
  658.         ENDIF
  659.         IF COLORPAL > CBUNCH
  660.             COLORPAL = 1
  661.         ENDIF
  662.     ENDDO
  663. ENDIF
  664. IF (SCRCHOICE = 8)
  665.     DO WHILE ('+' $ COLORS(COLORPAL) .OR. COLORS(COLORPAL) == NBACK)
  666.         COLORPAL = COLORPAL + ARRDIRECT
  667.         IF COLORPAL < 1
  668.             COLORPAL = CBUNCH
  669.         ENDIF
  670.         IF COLORPAL > CBUNCH
  671.             COLORPAL = 1
  672.         ENDIF
  673.     ENDDO
  674. ENDIF
  675. **    MENU FOREGROUND COLOR MUST BE BRIGHT
  676. IF (SCRCHOICE = 2)
  677.     DO WHILE (.NOT.'+' $ COLORS(COLORPAL))
  678.         COLORPAL = COLORPAL + ARRDIRECT
  679.         IF COLORPAL < 1
  680.             COLORPAL = CBUNCH
  681.         ENDIF
  682.         IF COLORPAL > CBUNCH
  683.             COLORPAL = 1
  684.         ENDIF
  685.     ENDDO
  686. ENDIF
  687. STORE 0 TO ARRDIRECT
  688. STORE COLORS(COLORPAL) TO NEWCOLOR
  689. DO CASE
  690.     CASE SCRCHOICE = 1
  691.         STORE NEWCOLOR TO NBACK
  692.     CASE SCRCHOICE = 2
  693.         STORE NEWCOLOR TO NMENF
  694.     CASE SCRCHOICE = 3
  695.         STORE NEWCOLOR TO NMENB
  696.     CASE SCRCHOICE = 4
  697.         STORE NEWCOLOR TO NHIGF
  698.     CASE SCRCHOICE = 5
  699.         STORE NEWCOLOR TO NHIGB
  700.     CASE SCRCHOICE = 6
  701.         STORE NEWCOLOR TO NTEXT
  702.     CASE SCRCHOICE = 7
  703.         STORE NEWCOLOR TO NSAYS
  704.     CASE SCRCHOICE = 8
  705.         STORE NEWCOLOR TO NGETS
  706. ENDCASE
  707. STORE NBACK TO MBACK
  708. STORE NTEXT+'/'+NBACK TO MTEXT
  709. STORE NSAYS+'/'+NBACK TO MSAYS
  710. STORE NSAYS+'/'+NGETS TO MGETS
  711. STORE NMENF+'/'+NMENB TO MMENU
  712. STORE SUBSTR(NMENF,1,AT('+',NMENF)-1)+'/'+NMENB TO NMSSG
  713. STORE MMENU TO MBOXS
  714. STORE NHIGF+'/'+NHIGB TO MHIGH
  715. STORE MHIGH TO MHOTK
  716. STORE MHIGH TO MTITL
  717. STORE 'R+/W' TO MERRMSG
  718. STORE 'GR+/B' TO MWRNMSG
  719. DO SAMPLSCRN
  720. RETURN
  721.  
  722. ************************************************************
  723. *                         COLSAVE                          *
  724. ************************************************************
  725. **    SAVE THE CURRENT COLOR CHOICES TO THE DATABASE WITH A NEW NAME
  726. PROCEDURE COLSAVE
  727. PRIVATE;
  728.     CNAME, CBACK, CTEXT, CSAYS, CGETS, CMENU, CHOTK, CBOXS, CTITL
  729. SET CURSOR ON
  730. SET COLOR OF FIELDS TO N/W
  731. STORE SPACE(10) TO CNAME
  732. CLEAR GETS
  733. @ 12,57 SAY 'ENTER COLOR SET NAME'
  734. @ 13,57 GET CNAME 
  735. READ
  736. SET CURSOR OFF
  737. STORE NBACK TO CBACK
  738. STORE NTEXT TO CTEXT
  739. STORE NSAYS TO CSAYS
  740. STORE NSAYS+'/'+NGETS TO CGETS
  741. **    TURN OFF HIGHLIGHT IN MENU FOREGROUND, FOXPRO MAKES BRIGHT AUTOMATICALLY
  742. **    TURN ON HIGHLIGHT IN BOXES FOREGROUND, TO MATCH THE MENU
  743. IF ('+' $ NMENF)
  744.     STORE SUBSTR(NMENF,1,AT('+',NMENF)-1) + '/' + NMENB TO CMENU
  745.     STORE NMENF+'/'+NMENB TO CBOXS
  746. ELSE
  747.     STORE NMENF + '/' + NMENB TO CMENU
  748.     STORE NMENF+'+/'+NMENB TO CBOXS
  749. ENDIF
  750. STORE NHIGF + '/' + NHIGB TO CHIGH
  751. STORE CHIGH TO CTITL
  752. STORE CHIGH TO CHOTK
  753. APPEND BLANK
  754. REPLACE    NAME WITH CNAME;
  755.         BACK WITH CBACK;
  756.         TEXT WITH CTEXT;
  757.         SAYS WITH CSAYS;
  758.         GETS WITH CGETS;
  759.         MENU WITH CMENU;
  760.         BOXS WITH CBOXS;
  761.         TITL WITH CTITL;
  762.         HIGH WITH CHIGH;
  763.         HOTK WITH CHOTK;
  764.         ERRMSG WITH 'R+/W';
  765.         WRNMSG WITH 'GR+/N'
  766. RETURN
  767.